home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir44 / dungn32.zip / GDT.FOR < prev    next >
Text File  |  1994-10-07  |  14KB  |  498 lines
  1. C Game debugging tool for DUNGEON
  2. C
  3. C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C Declarations
  8. C
  9.       SUBROUTINE GDT
  10.       IMPLICIT INTEGER (A-Z)
  11.       INCLUDE 'dparam.for'
  12.       PARAMETER (DBGMAX=38)                     ! number of debug commands
  13.       CHARACTER*2 CMD,DBGCMD(DBGMAX),DBGSML(DBGMAX)
  14.       INTEGER ARGTYP(DBGMAX)
  15.       LOGICAL VALID1,VALID2,VALID3
  16. C
  17. C Equivalanced array definitions
  18. C
  19.       INTEGER EQR(RMAX,5)
  20.       EQUIVALENCE (EQR(1,1),RDESC1(1))
  21.       INTEGER EQO(OMAX,14)
  22.       EQUIVALENCE (EQO(1,1),ODESC1(1))
  23.       INTEGER EQC(CMAX,2)
  24.       EQUIVALENCE (EQC(1,1),CTICK(1))
  25.       INTEGER EQV(VMAX,5)
  26.       EQUIVALENCE (EQV(1,1),VILLNS(1))
  27.       INTEGER EQA(AMAX,7)
  28.       EQUIVALENCE (EQA(1,1),AROOM(1))
  29. C
  30. C Functions and data
  31. C
  32.       VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
  33.       VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
  34.      1(A1.LE.A2)
  35.       VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
  36.       DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
  37.      1'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
  38.      2'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
  39.      3'AN','DM','DT','AH','DP','PD','DZ','AZ'/
  40.       DATA DBGSML/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
  41.      1'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
  42.      2'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
  43.      3'an','dm','dt','ah','dp','pd','dz','az'/
  44.       DATA ARGTYP/  2 ,  2 ,  2 ,  2 ,  2 ,  0 ,  0 ,  2 ,  2 ,  0 ,
  45.      1  1 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
  46.      2  1 ,  0 ,  3 ,  3 ,  3 ,  3 ,  1 ,  3 ,  2 ,  2 ,
  47.      3  1 ,  2 ,  1 ,  0 ,  0 ,  0 ,  0 ,  1 /
  48.  
  49. C GDT, PAGE 2
  50. C
  51. C First, validate that the caller is an implementer.
  52. C
  53.       IF(GDTFLG.NE.0) GO TO 2000                ! if ok, skip.
  54.       WRITE(OUTCH,100)                          ! not an implementer.
  55.       RETURN                                    ! boot him off
  56. C
  57. 100   FORMAT(' You are not an authorized user.')
  58.  
  59. c GDT, PAGE 2A
  60. C
  61. C Here to get next command.
  62. C
  63. 2000  WRITE(OUTCH,200)                          ! output prompt.
  64.       READ(INPCH,210,ERR=2200,END=31000) CMD    ! get command.
  65.       IF(CMD.EQ.'  ') GO TO 2000                ! ignore blanks.
  66.       DO 2100 I=1,DBGMAX                        ! look it up.
  67.         IF((CMD.EQ.DBGCMD(I)).OR.(CMD.EQ.DBGSML(I))) GO TO 2300
  68. 2100  CONTINUE                                  ! found?
  69. 2200  WRITE(OUTCH,220)                          ! no, lose.
  70.       GO TO 2000
  71. C
  72. 200   FORMAT(' GDT> ',$)
  73. 210   FORMAT(A2)
  74. 220   FORMAT(' ?')
  75. 230   FORMAT(2I6)
  76. 240   FORMAT(I6)
  77. 225   FORMAT(' Limits:   ',$)
  78. 235   FORMAT(' Entry:    ',$)
  79. 245   FORMAT(' Idx,Ary:  ',$)
  80. c
  81. 2300  GO TO (2400,2500,2600,2700),ARGTYP(I)+1   ! branch on arg type.
  82.       GO TO 2200                                ! illegal type.
  83. C
  84. 2700  WRITE(OUTCH,245)                          ! type 3, request array coords.
  85.       READ(INPCH,230,ERR=2200,END=2000) J,K
  86.       GO TO 2400
  87. C
  88. 2600  WRITE(OUTCH,225)                          ! type 2, read bounds.
  89.       READ(INPCH,230,ERR=2200,END=2000) J,K
  90.       IF(K.EQ.0) K=J
  91.       GO TO 2400
  92. C
  93. 2500  WRITE(OUTCH,235)                          ! type 1, read entry no.
  94.       READ(INPCH,240,ERR=2200,END=2000) J
  95. 2400  GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
  96.      119000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
  97.      229000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
  98.      339000,40000,41000,42000,43000,44000,45000,46000,47000),I
  99.       GO TO 2200                                ! what???
  100.  
  101. C GDT, PAGE 3
  102. C
  103. C DR-- Display Rooms
  104. C
  105. 10000 IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200      ! args valid?
  106.       WRITE(OUTCH,300)                          ! col hdrs.
  107.       DO 10100 I=J,K
  108.         WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
  109. 10100 CONTINUE
  110.       GO TO 2000
  111. C
  112. 300   FORMAT(' RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
  113. 310   FORMAT(1X,I3,4(1X,I6),1X,Z6)
  114. C
  115. C DO-- Display Objects
  116. C
  117. 11000 IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200      ! args valid?
  118.       WRITE(OUTCH,320)                          ! col hdrs
  119.       DO 11100 I=J,K
  120.         WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
  121. 11100 CONTINUE
  122.       GO TO 2000
  123. C
  124. 320   FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FV TV',
  125.      1'  SIZE CAPAC  ROOM ADV CON  READ')
  126. 330   FORMAT(1X,I3,3I6,I4,2Z7,2I3,2I6,I6,2I4,I6)
  127. C
  128. C DA-- Display Adventurers
  129. C
  130. 12000 IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200      ! args valid?
  131.       WRITE(OUTCH,340)
  132.       DO 12100 I=J,K
  133.         WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
  134. 12100 CONTINUE
  135.       GO TO 2000
  136. C
  137. 340   FORMAT(' AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
  138. 350   FORMAT(1X,I3,6(1X,I6),1X,Z6)
  139. C
  140. C DC-- Display Clock Events
  141. C
  142. 13000 IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200      ! args valid?
  143.       WRITE(OUTCH,360)
  144.       DO 13100 I=J,K
  145.         WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I),CCNCEL(I)
  146. 13100 CONTINUE
  147.       GO TO 2000
  148. C
  149. 360   FORMAT(' CL#   TICK ACTION  FLAG  CANCEL')
  150. 370   FORMAT(1X,I3,1X,I6,1X,I6,5X,L1,5X,L1)
  151. C
  152. C DX-- Display Exits
  153. C
  154. 14000 IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200      ! args valid?
  155.       WRITE(OUTCH,380)                          ! col hdrs.
  156.       DO 14100 I=J,K,10                         ! ten per line.
  157.         L=MIN0(I+9,K)                           ! compute end of line.
  158.         WRITE(OUTCH,390) I,L
  159.         DO 14050 L1=I,L                         ! loop through data
  160.           IF(TRAVEL(L1).GE.0) WRITE(OUTCH,391) TRAVEL(L1)
  161.           IF(TRAVEL(L1).LT.0) WRITE(OUTCH,392) TRAVEL(L1)
  162. 14050   CONTINUE
  163.       WRITE(OUTCH,393)
  164. 14100 CONTINUE
  165.       GO TO 2000
  166. C
  167. 380   FORMAT('     RANGE CONTENTS')
  168. 390   FORMAT(1X,I4,'-',I4,1X,$)
  169. 391   FORMAT('+',Z7,$)
  170. 392   FORMAT('+',I7,$)
  171. 393   FORMAT('+')
  172. C
  173. C DH-- Display Hacks
  174. C
  175. 15000 WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  176.       GO TO 2000
  177. C
  178. 400   FORMAT(' THFPOS=',I6,', THFFLG=',L2,', THFACT=',L2/
  179.      1' SWDACT=',L2,', SWDSTA=',I2)
  180. C
  181. C DL-- Display Lengths
  182. C
  183. 16000 WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
  184.      1MBASE,STRBIT
  185.       GO TO 2000
  186. C
  187. 410   FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
  188.      1' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
  189.      2' MBASE=',I6,', STRBIT=',I6)
  190. C
  191. C DV-- Display Villains
  192. C
  193. 17000 IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200      ! args valid?
  194.       WRITE(OUTCH,420)                          ! col hdrs
  195.       DO 17100 I=J,K
  196.         WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
  197. 17100 CONTINUE
  198.       GO TO 2000
  199. C
  200. 420   FORMAT(' VL# OBJECT   PROB   OPPS   BEST  MELEE')
  201. 430   FORMAT(1X,I3,5(1X,I6))
  202. C
  203. C DF-- Display Flags
  204. C
  205. 18000 IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200      ! args valid?
  206.       DO 18100 I=J,K
  207.         WRITE(OUTCH,440) I,FLAGS(I)
  208. 18100 CONTINUE
  209.       GO TO 2000
  210. C
  211. 440   FORMAT(' Flag #',I2,' = ',L1)
  212. C
  213. C DS-- Display State
  214. C
  215. 19000 WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
  216.       WRITE(OUTCH,460) WINNER,HERE,TELFLG
  217.       WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
  218.      1MUNGRM,HS,EGSCOR,EGMXSC
  219.       WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
  220.       GO TO 2000
  221. C
  222. 450   FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
  223. 460   FORMAT(' Play vector= ',2(1X,I6),1X,L6)
  224. 470   FORMAT(' State vector=',7(1X,I6)/14X,4(1X,I6))
  225. 475   FORMAT(' Scol vector= ',1X,Z6,2(1X,I6))
  226.  
  227. C GDT, PAGE 4
  228. C
  229. C AF-- Alter Flags
  230. C
  231. 20000 IF(.NOT.VALID1(J,FMAX)) GO TO 2200        ! entry no valid?
  232.       WRITE(OUTCH,480) FLAGS(J)                 ! type old, get new.
  233.       READ(INPCH,490,ERR=2200,END=2000) FLAGS(J)
  234.       GO TO 2000
  235. C
  236. 480   FORMAT(' Old=',L2,6X,'New= ',$)
  237. 490   FORMAT(L1)
  238. C
  239. C 21000-- Help
  240. C
  241. 21000 WRITE(OUTCH,900)
  242.       GO TO 2000
  243. C
  244. 900   FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
  245.      1' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
  246.      2' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
  247.      3' AV- Alter VILLS'/' AX- Alter EXITS'/
  248.      3' AZ- Alter PUZZLE'/' DA- Display ADVS'/
  249.      4' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
  250.      5' DL- Display lengths'/' DM- Display RTEXT'/
  251.      6' DN- Display switches'/
  252.      6' DO- Display OBJCTS'/' DP- Display parser'/
  253.      6' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
  254.      7' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
  255.      8' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
  256.      9' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
  257.      1' NT- No troll'/' PD- Program detail'/
  258.      1' RC- Restore cyclops'/' RD- Restore deaths'/
  259.      2' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
  260. C
  261. C NR-- No Robber
  262. C
  263. 22000 THFFLG=.FALSE.                            ! disable robber.
  264.       THFACT=.FALSE.
  265.       CALL NEWSTA(THIEF,0,0,0,0)                ! vanish thief.
  266.       WRITE(OUTCH,500)
  267.       GO TO 2000
  268. C
  269. 500   FORMAT(' No robber.')
  270. C
  271. C NT-- No Troll
  272. C
  273. 23000 TROLLF=.TRUE.
  274.       CALL NEWSTA(TROLL,0,0,0,0)
  275.       WRITE(OUTCH,510)
  276.       GO TO 2000
  277. C
  278. 510   FORMAT(' No troll.')
  279. C
  280. C NC-- No Cyclops
  281. C
  282. 24000 CYCLOF=.TRUE.
  283.       CALL NEWSTA(CYCLO,0,0,0,0)
  284.       WRITE(OUTCH,520)
  285.       GO TO 2000
  286. C
  287. 520   FORMAT(' No cyclops.')
  288. C
  289. C ND-- Immortality Mode
  290. C
  291. 25000 DBGFLG=1
  292.       WRITE(OUTCH,530)
  293.       GO TO 2000
  294. C
  295. 530   FORMAT(' No deaths.')
  296. C
  297. C RR-- Restore Robber
  298. C
  299. 26000 THFACT=.TRUE.
  300.       WRITE(OUTCH,540)
  301.       GO TO 2000
  302. C
  303. 540   FORMAT(' Restored robber.')
  304. C
  305. C RT-- Restore Troll
  306. C
  307. 27000 TROLLF=.FALSE.
  308.       CALL NEWSTA(TROLL,0,MTROL,0,0)
  309.       WRITE(OUTCH,550)
  310.       GO TO 2000
  311. C
  312. 550   FORMAT(' Restored troll.')
  313. C
  314. C RC-- Restore Cyclops
  315. C
  316. 28000 CYCLOF=.FALSE.
  317.       MAGICF=.FALSE.
  318.       CALL NEWSTA(CYCLO,0,MCYCL,0,0)
  319.       WRITE(OUTCH,560)
  320.       GO TO 2000
  321. C
  322. 560   FORMAT(' Restored cyclops.')
  323. C
  324. C RD-- Mortal Mode
  325. C
  326. 29000 DBGFLG=0
  327.       WRITE(OUTCH,570)
  328.       GO TO 2000
  329. C
  330. 570   FORMAT(' Restored deaths.')
  331.  
  332. C GDT, PAGE 5
  333. C
  334. C TK-- Take
  335. C
  336. 30000 IF(.NOT.VALID1(J,OLNT)) GO TO 2200        ! valid object?
  337.       CALL NEWSTA(J,0,0,0,WINNER)               ! yes, take object.
  338.       WRITE(OUTCH,580)                          ! tell.
  339.       GO TO 2000
  340. C
  341. 580   FORMAT(' Taken.')
  342. C
  343. C EX-- Goodbye
  344. C
  345. 31000 RETURN
  346. C
  347. C AR-- Alter Room Entry
  348. C
  349. 32000 IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200    ! indices valid?
  350.       WRITE(OUTCH,590) EQR(J,K)                 ! type old, get new.
  351.       READ(INPCH,600,ERR=2200,END=2000) EQR(J,K)
  352.       GO TO 2000
  353. C
  354. 590   FORMAT(' Old= ',I6,6X,'New= ',$)
  355. 600   FORMAT(I6)
  356. C
  357. C AO-- Alter Object Entry
  358. C
  359. 33000 IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200   ! indices valid?
  360.       WRITE(OUTCH,590) EQO(J,K)
  361.       READ(INPCH,600,ERR=2200,END=2000) EQO(J,K)
  362.       GO TO 2000
  363. C
  364. C AA-- Alter Advs Entry
  365. C
  366. 34000 IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200    ! indices valid?
  367.       WRITE(OUTCH,590) EQA(J,K)
  368.       READ(INPCH,600,ERR=2200,END=2000) EQA(J,K)
  369.       GO TO 2000
  370. C
  371. C AC-- Alter Clock Events
  372. C
  373. 35000 IF(.NOT.VALID3(J,CLNT,K,4)) GO TO 2200    ! indices valid?
  374.       IF(K.EQ.3) GO TO 35500                    ! flags entry?
  375.       IF(K.EQ.4) GO TO 35600                    ! cancel entry?
  376.       WRITE(OUTCH,590) EQC(J,K)
  377.       READ(INPCH,600,ERR=2200,END=2000) EQC(J,K)
  378.       GO TO 2000
  379. C
  380. 35500 WRITE(OUTCH,480) CFLAG(J)
  381.       READ(INPCH,490,ERR=2200,END=2000) CFLAG(J)
  382.       GO TO 2000
  383. C
  384. 35600 WRITE(OUTCH,480) CCNCEL(J)
  385.       READ(INPCH,490,ERR=2200,END=2000) CCNCEL(J)
  386.       GO TO 2000
  387.  
  388. C GDT, PAGE 6
  389. C
  390. C AX-- Alter Exits
  391. C
  392. 36000 IF(.NOT.VALID1(J,XLNT)) GO TO 2200        ! entry no valid?
  393.       IF(TRAVEL(J).LT.0) GO TO 36100            ! string entry?
  394.       WRITE(OUTCH,610) TRAVEL(J)
  395.       READ(INPCH,620,ERR=2200,END=2000) TRAVEL(J)
  396.       GO TO 2000
  397. C
  398. 36100 WRITE(OUTCH,590) TRAVEL(J)
  399.       READ(INPCH,600,ERR=2200,END=2000) TRAVEL(J)
  400.       GO TO 2000
  401. C
  402. 610   FORMAT(' Old= ',Z6,6X,'New= ',$)
  403. 620   FORMAT(Z6)
  404. C
  405. C AV-- Alter Villains
  406. C
  407. 37000 IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200    ! indices valid?
  408.       WRITE(OUTCH,590) EQV(J,K)
  409.       READ(INPCH,600,ERR=2200,END=2000) EQV(J,K)
  410.       GO TO 2000
  411. C
  412. C D2-- Display Room2 List
  413. C
  414. 38000 IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
  415.       DO 38100 I=J,K
  416.         WRITE(OUTCH,630) I,R2(I),O2(I)
  417. 38100 CONTINUE
  418.       GO TO 2000
  419. C
  420. 630   FORMAT(' #',I2,'   Room=',I6,'   Obj=',I6)
  421. C
  422. C DN-- Display Switches
  423. C
  424. 39000 IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200      ! valid?
  425.       DO 39100 I=J,K
  426.         WRITE(OUTCH,640) I,SWITCH(I)
  427. 39100 CONTINUE
  428.       GO TO 2000
  429. C
  430. 640   FORMAT(' Switch #',I2,' = ',I6)
  431. C
  432. C AN-- Alter Switches
  433. C
  434. 40000 IF(.NOT.VALID1(J,SMAX)) GO TO 2200        ! valid entry?
  435.       WRITE(OUTCH,590) SWITCH(J)
  436.       READ(INPCH,600,ERR=2200,END=2000) SWITCH(J)
  437.       GO TO 2000
  438. C
  439. C DM-- Display Messages
  440. C
  441. 41000 IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200      ! valid limits?
  442.       WRITE(OUTCH,380)
  443.       DO 41100 I=J,K,10
  444.         L=MIN0(I+9,K)
  445.         WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
  446. 41100 CONTINUE
  447.       GO TO 2000
  448. C
  449. 650   FORMAT(1X,I4,'-',I4,10(1X,I6))
  450. C
  451. C DT-- Display Text
  452. C
  453. 42000 CALL RSPEAK(J)
  454.       GO TO 2000
  455. C
  456. C AH-- Alter Here
  457. C
  458. 43000 WRITE(OUTCH,590) HERE
  459.       READ(INPCH,600,ERR=2200,END=2000) HERE
  460.       AROOM(PLAYER)=HERE
  461.       GO TO 2000
  462. C
  463. C DP-- Display Parser State
  464. C
  465. 44000 WRITE(OUTCH,660)
  466.      1OFLAG,OACT,OPREP1,OOBJ1,OPREP,ONAME,OPREP2,OOBJ2,
  467.      2LASTIT,ACT,OBJ1,OBJ2,PREP1,PREP2,SYN,
  468.      3BUNLNT,BUNSUB,BUNVEC
  469.       GO TO 2000
  470. C
  471. 660   FORMAT(' ORPHS= ',5I7,' "',A,'" ',2I7/' IT=    ',I7/
  472.      1' PV=    ',5I7/' SYN=   ',2Z7,4I7/15X,Z7,4I7/
  473.      2' BUNCH= ',7I7/22X,5I7)
  474. C
  475. C PD-- Program Detail
  476. C
  477. 45000 WRITE(OUTCH,610) PRSFLG                   ! type old, get new.
  478.       READ(INPCH,620,ERR=2200,END=2000) PRSFLG
  479.       GO TO 2000
  480. C
  481. C DZ-- Display Puzzle Room
  482. C
  483. 46000 DO 46100 I=1,64,8                         ! display puzzle
  484.         WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
  485. 46100 CONTINUE
  486.       GO TO 2000
  487. C
  488. 670   FORMAT(2X,8I3)
  489. C
  490. C AZ-- Alter Puzzle Room
  491. C
  492. 47000 IF(.NOT.VALID1(J,64)) GO TO 2200          ! valid entry?
  493.       WRITE(OUTCH,590) CPVEC(J)                 ! output old,
  494.       READ(OUTCH,600) CPVEC(J)                  ! get new.
  495.       GO TO 2000
  496. C
  497.       END
  498.